home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48_2
/
yatsrc_d
< prev
next >
Wrap
Internet Message Format
|
1995-03-31
|
22KB
From: Detlef Mueller <detlef@mwhh.hanse.de>
Subject: v04i029: yatsrc_dm - Source of YAT v1.4, Part01/01
Newsgroups: comp.sources.hp48
Keywords: HP48 game sys-RPL source TETRIS
Organization: Nothin' is organized here.
Followup-To: comp.sys.hp48
Approved: spell@seq.uncwil.edu
Checksum: 3529862805 (verify with brik -cv)
Submitted-by: Detlef Mueller <detlef@mwhh.hanse.de>
Posting-number: Volume 4, Issue 29
Archive-name: yatsrc_dm/part01
BEGIN_DOC Tetris.doc
Hi folks.
Because I've no time to support YAT (Yet Another Tetris) any more, I release
the source.
I made YAT using the HP RPL development toolkit; to build the library you
need to have a MesS-DOS machine with the HP stuff installed. Process the
following steps:
1) Cut out the listings and put them into the appropriate files
2) Run MKTET.BAT
3) Now you can download TETRIS.LIB into your HP48
For further information see the article 'v03i023: yat_dm - Yet Another Tetris
version 1.4, Part01/01', published on Feb-16-92 in comp.sources.hp48.
Bye,
8-Detlef
P.S. BTW, is somebody using the RPL:2.1 library ? Because I'm working on
the 2.2 release, I would be interrested in suggestions. DM
END_DOC
BEGIN_SRC mktet.bat
RPLCOMP tetris.S tetris.A tetris.EXT
SASM -e -N tetris
MAKEROM tetris.MN tetris.M
SASM -e -N tHEAD
SASM -e -N tHASH
SASM -e -N tEND
SLOAD tetris.M
SLOAD -H t.M
END_SRC
BEGIN_SRC tetris.mn
TITLE Tetris Library
OUTPUT t.o
LLIST t.lr
CONFIGURE TEcfg
NAME TETRIS:1.4,(c)DM'92
ROMPHEAD thead.a
REL tetris.o
TABLE thash.a
FINISH tend.a
END
END_SRC
BEGIN_SRC t.m
TITLE Tetris library
OUTPUT tetris.lib
OPTION CODE
LLIST tetris.lr
SUPPRESS XR
SEARCH entries.o
REL t.o
CK LIB301 SYSEND301
END_SRC
BEGIN_SRC tetris.s
*****************************************************************************
* Modulname: TETRIS
* Modultype: Library
* Dest.Comp.: HP48
* Language: System RPL
* Author: Detlef Mueller,Bellerbek 33,2000 Hamburg 56,Germany
* Interface: TETRIS
* Description: The game 'TETRIS' was originally writen by Lennart Boerjeson
* (freeware), greatly modified by Raymond Hellstern, and now
* rewriten from DM.
* This library uses the number 769 because nobody would really
* interested in the CASINO48 module (I think ?!).
* To do: --
* Edition History :
* 0.000 08.08.1991 DM Alpha version
* 0.100 17.08.1991 DM Change to bint
* 1.000 24.08.1991 DM 1st offical release
* 100 25.08.1991 DM minor changes
* 200 25.08.1991 DM correct/condense stone data
* 300 09.09.1991 DM add pause screen
* 400 19.09.1991 DM fix some things
* 401 22.12.1991 DM fix ERRTRAP, first line clear
* 402 21.01.1992 DM Georg-version.Lines marked with ( ** )
* 403 20.03.1992 DM release source
* Copyright :
* (c) 1992 by Detlef Mueller. ALL rights reserved.
*****************************************************************************
TITLE TETRIS
*****************************************************************************
* INCLUDE FILES
*****************************************************************************
INCLUDE keydefs.h
*****************************************************************************
* ROM ID DEFINITIONS -> 769
*****************************************************************************
xROMID 301
ASSEMBLE
GAROMID EQU #301
DOBIND EQU #074E4
NIBASC /HPHP48-E/ Binary download header
MKGROB MACRO * x,y
CON(5) =DOGROB
CON(5) 15+(($1+7)/8)*$2*2
CON(5) $2
CON(5) $1
MKGROB ENDM
MKSGROB MACRO * x,y,nnnn
CON(5) =DOGROB
CON(5) 15+(($1+7)/8)*$2*2
CON(5) $2
CON(5) $1
NIBHEX $3
MKSGROB ENDM
RPL
*****************************************************************************
* EXTERNAL DEFINITIONS
*****************************************************************************
EXTERNAL xTETRIS
EXTERNAL Install
EXTERNAL Play
EXTERNAL Byebye
EXTERNAL UpdatVal
EXTERNAL LinesUp
EXTERNAL LevelUp
EXTERNAL StIsDown
EXTERNAL Actions
EXTERNAL ChkKeys
EXTERNAL MoveStX
EXTERNAL Pause
EXTERNAL StoneHandler
EXTERNAL Stones
*****************************************************************************
* DEFINES
*****************************************************************************
DEFINE SetSt 1GETLAM EVAL ( *'Set stone'* )
DEFINE TstSt 2GETEVAL ( *'Test stone'* )
DEFINE @Timer 3GETLAM ( *Timing value* )
DEFINE !Timer 3PUTLAM
DEFINE @NxtStIm 4GETLAM ( *Next stone image* )
DEFINE !NxtStIm 4PUTLAM
DEFINE @NxtStNo 5GETLAM ( *Next stone number* )
DEFINE !NxtStNo 5PUTLAM
DEFINE @Level 6GETLAM ( *Level* )
DEFINE !Level 6PUTLAM
DEFINE @Score 7GETLAM ( *Score* )
DEFINE !Score 7PUTLAM
DEFINE @Lines 8GETLAM ( *Full lines* )
DEFINE !Lines 8PUTLAM
DEFINE @StNo 9GETLAM ( *Stone number* )
DEFINE !StNo 9PUTLAM
DEFINE @StDir 10GETLAM ( *Stone direction* )
DEFINE !StDir 10PUTLAM
DEFINE @StFt 11GETLAM ( *Stone falltime* )
DEFINE !StFt 11PUTLAM
DEFINE @A 12GETLAM ( *Temporary A* )
DEFINE !A 12PUTLAM
DEFINE ClrDrpReq ONE ClrUserFlag ( *Stone drop request flag* )
DEFINE SetDrpReq ONE SetUserFlag
DEFINE DrpReq? ONE TestUserFlag
DEFINE ClrQuit TWO ClrUserFlag ( *Quit game request* )
DEFINE SetQuit TWO SetUserFlag
DEFINE Quit? TWO TestUserFlag
DEFINE ClrPreV THREE ClrUserFlag ( *Preview on/off* )
DEFINE SetPreV THREE SetUserFlag
DEFINE PreV? THREE TestUserFlag
*****************************************************************************
* OBJECTS
*****************************************************************************
*** TEcfg *******************************************************************
* Interface : ( --> )
* Description : Attach this library
* Ed. History :
* 1.000 07.08.1991 DM start
*****************************************************************************
ASSEMBLE
=TEcfg
RPL
::
[#] GAROMID TOSRRP ( *Autoattach* )
;
*** xTETRIS *****************************************************************
* Interface : ( --> )
* Description : Main program TETRIS
* Ed. History :
* 1.000 08.08.1991 DM start
*****************************************************************************
ASSEMBLE
CON(1) 8 * Tell parser 'Non algebraic'
RPL
xNAME TETRIS
::
CK0
ClrDA1IsStat RECLAIMDISP TURNMENUOFF
ERRSET
:: Install ( *Install TETRIS* )
Play ( *Do it* )
Byebye ( *Game over ..* )
;
ERRTRAP
:: TURNMENUON RECLAIMDISP
ERROR@ JstGETTHEMSG
"TETRIS Failed"
DISPROW1 DISPROW2 SetDA1Temp
;
ATTNFLGCLR FLUSHKEYS
;
*** Install *****************************************************************
* Interface : ( --> )
* Description : Setup TETRIS environment, init game screen
* Ed. History :
* 1.000 08.08.1991 DM start
*****************************************************************************
NULLNAME Install
::
ZEROZEROZERO ZEROZEROZERO ZERO ( *Initial: A, falltime, stone dir,* )
( *nr, lines, score, level* )
%RAN %7 %* %IP># #1+DUP ( *Determine first stone nr.* )
Stones SWAP NTHCOMPDROP CARCOMP ( *Determine first stone image* )
% 0.19 ( *Timer value = .19 - lev * .0171* )
StoneHandler INCOMPDROP ( *Tst/SetStone* )
' NULLLAM TWELVE NDUPN DOBIND ( *Generate game environment* )
( *Setup screen* )
FORTYTHREE ZEROOVER SIXTY ( *Draw field* )
84 ZEROOVER 4PICK
6PICK OVER 4PICK OVER
LINEON LINEON LINEON
110 FIFTYSIX "QUIT" MakeStdLabel ( *Menue lables* )
88 FIFTYSIX "+LEVL" MakeStdLabel
TWENTYTWO FIFTYSIX "PVT" MakeStdLabel
ZERO FIFTYSIX "PAUSE" MakeStdLabel
TWO THIRTYSIX "LINES" $>grob ( *Score field* )
TWO NINETEEN "LEVEL" $>grob
TWO DUP "SCORE" $>grob
91 TWO ( *Help screen* )
ASSEMBLE
MKGROB 38,48
NIBHEX FFFFFFFFF35240408092FFFFFFFFF30000000000F7FBFBF4E180104805128010
NIBHEX 480510801048051080F148F4E180104824028010484402801048841280F34805
NIBHEX E10000000000FFFFFFFFF35240408092FFFFFFFFF300000000000002E1000000
NIBHEX 06120000000E040000000E140000000E34000000000000008CFFFFF720C40404
NIBHEX 0460E4A44494E0F5A4E4B4F1E4A4F5F4E0C44CF7D46084440494200404040400
NIBHEX 0CFFFFF700048404240004C404640004ECF7E40004F4F5E50004E4E4E40004C4
NIBHEX 44640004840424000CFFFFF7000000000000000040000000004000000008F300
NIBHEX 000000F100000000E000000000400000
RPL
EIGHT
ZERO_DO (DO)
XYGROBDISP
LOOP
FORTYTWO FIFTYSEVEN OVER SIXTYTHREE
LINEOFF ( *Clr. last col. of 'PVT'* )
NINE TWENTYSIX FORTYTHREE ( *Display 0 score/level/lines* )
THREE
ZERO_DO (DO)
ZERO UpdatVal
LOOP
ClrQuit SetPreV ( *Init. flags* )
Pause ( *Initial screen* )
;
*** Play ********************************************************************
* Interface : ( --> )
* Description : Inner TETRIS loop
* Modifies : StNo StDir NxtStNo NxtStIm StFt Quit
* Ed. History :
* 1.000 08.08.1991 DM start
*****************************************************************************
NULLNAME Play
::
BEGIN
@NxtStIm @NxtStNo !StNo
ONE !StDir
Stones %RAN %7 %* %IP># #1+DUP ( *Determine, ..* )
!NxtStNo NTHCOMPDROP CARCOMP ( *.. store next stone nr, get st. blocks* )
!NxtStIm ( *Store next stone image* )
PreV? IT
:: #C06 ZERO SetSt ( *Clr preview field* )
@NxtStIm SWAP
#F99F SetSt 2DROP ( *Preview stone at [6,12]* )
;
ZERO !StFt ( *Reset falltime* )
ClrDrpReq ( *Clr drop flag* )
FOURTEEN ( *Start stone at [14,0]* )
2DUP TstSt #0=ITE ( *Stone has room ?* )
:: ( *Yes* )
#F99F SetSt ( *Draw stone in 1st position* )
BEGIN ( --> hxs stim hxs p )
DrpReq? ?SKIP ( *Skip key's if drop req.* )
:: THREE
ZERO_DO (DO)
ChkKeys ( *Check for pending keys* )
LOOP
@StFt #1+ !StFt ( *Update falltime* )
ATTN? NOT?SEMI
SetQuit ( *Attn, quick out* )
;
Quit? ?SKIP ( *Skip on quit req.* )
:: ZERO SetSt ( *Undraw stone* )
REALOBOB #+ ( *y += 1* )
2DUP TstSt
#0=case ( *Stone down ?* )
:: #F99F SetSt ( *No, draw stone* )
;
( *Stone is down* )
REALOBOB #- #F99F
SetSt ( *Draw st. in last pos* )
DrpReq? case ( *Drop requested ?* )
:: ClrDrpReq ( *Yes, chance to move stone in x* )
;
2DROP ZERO ( hxs[si] #[pos] --> # *Signal down* )
;
DUP#0= Quit? OR
UNTIL
;
:: SetQuit ( *No room, so quit* )
;
#0<> Quit? AND
ITE
DROP ( *Abort by Quit/ATTN* )
StIsDown ( *Abort by st. down* )
Quit? ( *Until quit* )
UNTIL
;
*** Byebye ******************************************************************
* Interface : ( --> )
* Description : TETRIS game over sequence
* Modifies : A Drop Quit Pv
* Ed. History :
* 1.000 08.08.1991 DM start
*****************************************************************************
NULLNAME Byebye
::
ATTN? ?SKIP ( *Skip if ATTN pressed* )
:: FORTYFOUR TWENTYFIVE
ASSEMBLE
MKSGROB 40,7,0000000000C94470757324D6105515AD557055732554105215C5547072750000000000
RPL
XYGROBDISP ( *Show 'Game Over'* )
5400 !A ( *Generate sound values* )
THIRTEEN
ZERO_DO (DO)
SIX @A DUP 400 #- !A
LOOP
THIRTEEN ( *Generate sound* )
ZERO_DO (DO)
setbeep
LOOP
FLUSHKEYS WaitForKey 2DROP
;
ABND ( *Abandon game environment* )
ClrQuit ClrPreV ( *Clear user flags* )
TURNMENUON RECLAIMDISP ( *Restore screen* )
;
*** UpdatVal ****************************************************************
* Interface : ( #y #val --> )
* Description : Show val at 2,y in medium font on screen
* Ed. History :
* 1.000 18.08.1991 DM start
*****************************************************************************
NULLNAME UpdatVal
::
#>$ $>GROB TWO ROT ( --> grob #2 #y )
HARDBUFF UNROT ( --> grob hb #x #y )
GROB!
;
*** LinesUp *****************************************************************
* Interface : ( #pos --> #pos )
* Description : Update game field, increment lines, correct level
* Modifies : Lines
* Ed. History :
* 1.000 18.08.1991 DM start
* 001 03.12.1991 DM clear first row
*****************************************************************************
NULLNAME LinesUp
::
DUP REALOBOB #/ SWAPDROP #2* #2* ( #y*4 )
HARDBUFF FORTYFOUR ZERO 84 5ROLL ( hb #44 #0 #84 #y )
SUBGROB ( grob )
HARDBUFF FORTYFOUR FOUR GROB! ( *Clear full line* )
HARDBUFF FORTYFOUR ZERO 84 FOUR GROB!ZERODRP
@Lines #1+DUP !Lines ( *Update full lines value* )
FORTYTHREE OVER UpdatVal ( *Update screen* )
FIFTEEN 400 TWENTYFOUR 300
setbeep setbeep ( *Generate full line sound* )
FIVE #/ SWAPDROP @Level #> NOT?SEMI ( *1 level up* )
NULLNAME LevelUp ( --> )
::
TWENTYSIX @Level #1+DUP !Level ( *Update level value* )
UpdatVal ( *Update screen* )
@Timer % 0.0171 %- % 0.0001 %MAX
!Timer ( *Update timer value* )
;
;
*** StIsDown ****************************************************************
* Interface : ( --> )
* Description : Stone is down, so update score, check if lines are full, et c.
* Modifies : Score
* Ed. History :
* 1.000 08.08.1991 DM start
*****************************************************************************
NULLNAME StIsDown
::
@Score DUP
@Level PreV? ITE TWO THREE #* TWENTYSEVEN #+ @StFt #- #+DUP
!Score ( #o #n *Update score value* )
NINE OVER UpdatVal
1000 #/ SWAPDROPSWAP 1000 #/ SWAPDROP
#<> IT ( *Next 1000* )
:: SEVEN 700 EIGHT 500
setbeep setbeep ( *Generate sound* )
;
#E0B ( *[11,14]* )
BEGIN
HXS F 000100200300400 OVER ( #[pos] hxs[fl] #[pos] )
2DUP TstSt UNROT ( #[pos] #[f] hxs[fl] #[pos] )
#5+ ( *x += 5* )
TstSt #+ FOUR #=ITE
LinesUp ( *Line full* )
:: REALOBOB #- ( *--y* )
;
#200 OVER#> ( *2 > y* )
UNTIL DROP
FLUSHKEYS GARBAGE ( *Clr. key buf., force garbage coll.* )
;
*** ChkKeys *****************************************************************
* Interface : ( hxs(stim) #(p) --> hxs(stim) #(p) )
* Description : Check for pending keystroce, perform action, perf. speed ctrl.
* Modifies : Drop Pv Quit
* Ed. History :
* 1.000 08.08.1991 DM start
*****************************************************************************
NULLNAME Actions
{
:: ( *Rotate stone* )
( hxs[sblk] #p --> hxs[sblk]' #p )
ZERO SetSt ( *Clear stone* )
Stones @StNo NTHCOMPDROP
@StDir #1-
DUP#0=IT ( *Get stone images, new direction* )
:: DROP DUPLENCOMP
;
DUP !A ( *Store new direction* )
NTHCOMPDROP SWAP ( hxs[i] hxs[i'] #[p] )
2DUP TstSt #0=ITE
:: ROTDROP @A !StDir
;
SWAPDROP
#F99F SetSt ( *Draw stone* )
;
:: ( *Stone left* )
ZERO SetSt
MINUSONE MoveStX DROP
#F99F SetSt
;
:: ( *Stone right* )
ZERO SetSt
ONE MoveStX DROP
#F99F SetSt
;
:: ( *Stone left as possible* )
ZERO SetSt
BEGIN
MINUSONE MoveStX
UNTIL
#F99F SetSt
;
:: ( *Stone right as possible* )
ZERO SetSt
BEGIN
ONE MoveStX
UNTIL
#F99F SetSt
;
:: ( *Drop stone* )
SetDrpReq
;
Pause
:: ( *Toggle stone preview* )
THREE DUP TestUserFlag
case
:: ClrUserFlag ( *Preview off* )
@NxtStIm #C06 ZERO ( *Clr preview field* )
SetSt 2DROP
;
SetUserFlag
@NxtStIm #C06 #F99F ( *Preview stone at [20,10]* )
SetSt 2DROP
;
LevelUp
:: ( *Quit game* )
SetQuit
;
:: ( *Toggle sound* )
FIFTYSIX DUP
TestSysFlag
case
ClrSysFlag
SetSysFlag
;
}
NULLNAME ChkKeys
::
@Timer dowait ( *Perform speed control* )
GETTOUCH NOT?SEMI
H/W>KeyCode
Actions
{ kcUpArrow kcLeftArrow kcRightArrow
kcVarsMenu kcNextRow kcDownArrow
kcMenuKey1 kcMenuKey2 kcMenuKey5 kcMenuKey6
kcNegate
* kc8 kc4 kc6 ( ** )
* kc7 kc9 kc5 ( ** )
}
ROT ' #= POSCOMP
* ELEVEN OVER#< IT ( ** )
* :: ELEVEN #- ( ** )
* ; ( ** )
NTHELCOMP IT EVAL
;
*** MoveStX *****************************************************************
* Interface : ( hxs(sblk) #(p) #(stp) --> hxs(sblk) #(p') flag )
* Description : Move stone x stp, stone left clear on screen
* Modifies : A
* Ed. History :
* 1.000 08.08.1991 DM start
*****************************************************************************
NULLNAME MoveStX
::
DUP !A ( *Store step* )
#+ ( *New stone pos* )
2DUP TstSt #0= ( *Check if stone has room* )
caseFALSE
@A #- TRUE ( *No room, so restore pos* )
;
*** Pause *******************************************************************
* Interface : ( --> )
* Description : Store, clear game area, show pause grob, wait for key,
* restore game area.
* Ed. History :
* 1.000 09.09.1991 DM start
*****************************************************************************
NULLNAME Pause
::
FORTYFOUR ZERO 2DUP HARDBUFF UNROT ( x1 y1 hb x1 y1 )
84 SIXTY SUBGROB UNROT ( grob x1 y1 )
2DUP HARDBUFF UNROT 84 SIXTY GROB!ZERODRP
FORTYFIVE TWENTY
ASSEMBLE
MKGROB 37,39
NIBHEX 080051000008005100000E30510000080051010008984201000C8842C70008EB
NIBHEX 420100088CF70300049505810004D40501000A84C701000AA405820009C50782
NIBHEX 0084E585450082B205450089A205290084B68252100FAA83941009AAC6391009
NIBHEX AA45521009AAAAEF0001F76D28000114AA28000F14C7EF00011444101001F74C
NIBHEX FF300908CF0020880828002084001010208FFFFFFF30C429429460A4294294A0
NIBHEX FFFFFFFFF110001100011008020001100802000110080200011008020001FFFF
NIBHEX FFFFF1
RPL
SIXTY THREE
ASSEMBLE
MKSGROB 7,17,8080E38081C0804122141422C1414141C1
RPL
XYGROBDISP XYGROBDISP
WaitForKey 2DROP
ROT XYGROBDISP
GARBAGE
;
*** StoneHandler ************************************************************
* Interface : ( --> {} )
* Description :
* Ed. History :
* 0.000 xx.xx.1991 RH alpha ver
* 1.000 08.08.1991 DM start conversion
* 001 17.08.1991 DM chg to support bint's
* 002 25.08.1991 DM chg to support HXS x nnn
*****************************************************************************
NULLNAME StoneHandler
{
:: ( *Test if room* hxs[image] #[pos] --> # )
TOTEMPOB
CODE
* CPU A B C D0 D1 Rx
CD0EX rsp
R2=C R2=rsp
BCEX A retstk
R3=C R3=retstk
C=DAT1 A pos
D0=C pos
R1=C R1=pos
D0=D0+ 5 &pos
A=0 W
A=DAT0 A pos
R0=A R0=pos
D=D+1 A *** Pop #[pos] from stack ***
D1=D1+ 5
A=DAT1 A &hxs[i]
DAT1=C A *** hxs becomes # ***
AD0EX &hxs[i]
D0=D0+ 5 &len
C=0 W 0
C=DAT0 2 len
D0=D0+ 5 &imag
C=C-CON A,6
P=C 0
C=DAT0 WP imag
A=C W imag
B=0 W 0
TLoop B=0 A
P= 2
B=C WP next coord.
C=R0 pos
C=C+B A offs
B=C A offs
BSR A >> 4
P= 2
B=C P
P= 0
B=0 P
BSRB.F A
P= 2
C=0 P
B=B+C A
P= 0
D0=(5) =VDISP
C=DAT0 A
C=C+CON A,10
C=C+CON A,10
C=C+B A
CD0EX
C=0 W
C=DAT0 P
?C=0 P
GOYES TCont4
B=B+1 S
GOTO TCont5
TCont4 P= 15
LCHEX 8
P= 0
B=B!C S
TCont5 ASR W
ASR W
ASR W
C=A W
?C#0 A
GOYES TLoop
A=0 W
C=0 W
A=B S
ASLC
?ABIT=1 3
GOYES TCont6
C=C+1 A
TCont6 ABIT=0 3
?A=0 B
GOYES TCont7
C=C+1 A
TCont7 A=R1 pos
AD0EX pos
D0=D0+ 5 &pos
DAT0=C A
C=R3 retstk
BCEX A retstk
C=R2 rsp
CD0EX rsp
P= 0
LOOP *** Jump to next RPL instr. in runstream ***
ENDCODE
;
( *Draw image* hxs[image] #[pos] #[patt] --> hxs pos )
CODE
* CPU A B C D0 D1 R0 R1
A=0 W 0
GOSBVL =POP# patt
GOSBVL =SAVPTR
R1=A patt
GOSBVL =POP# pos
R0=A pos
A=DAT1 A &hxs
AD0EX &hxs
D0=D0+ 10 &image
C=0 W 0
C=DAT0 12 image[12]
A=C W image
XLoop B=0 W 0
P= 2
B=C WP C[2]=x
C=R0 pos
C=C+B A pos+x
B=C W pos+x
BSR W >>= 4
P= 2
B=C P
P= 0
B=0 P
BSRB B >>= 1
P= 2
C=0 P C[2] = 0
B=B+C A B[A] = offset in screen
P= 0
D0=(5) =VDISP
C=DAT0 A
C=C+CON A,10
C=C+CON A,10
C=C+B A
D0=C
C=R1 C = [patt]
CSL W C <<= 4
CSL W C <<= 4
P= 4
XCont4 DAT0=C XS
CSR W
D0=D0+ 16
D0=D0+ 16
D0=D0+ 2
P=P-1
?P# 0
GOYES XCont4
ASR W
ASR W
ASR W A >>= 12
C=A W
?C#0 A
GOYES XLoop
P= 0
GOSBVL =GETPTRLOOP Restore RPL values, dispatch to runstream
ENDCODE
}
*** Stones ******************************************************************
* Interface : ( --> {} )
* Description :
* Ed. History :
* 0.000 xx.xx.1991 RH alpha ver
* 1.000 08.08.1991 DM start
* 001 25.08.1991 DM chg to HXS C xx, correct pos
*****************************************************************************
NULLNAME Stones
{
{ HXS C 301100300200
HXS C 102202201200
HXS C 101301201100
HXS C 102200100101
}
{ HXS C 101300200100
HXS C 202100200201
HXS C 101301201300
HXS C 202102101100
}
{ HXS C 201100300200
HXS C 202101200201
HXS C 101301200201
HXS C 202301201200
}
{ HXS C 101300201200
HXS C 302201301200
}
{ HXS C 301100201200
HXS C 102201101200
}
{ HXS C 000300100200
HXS C 103102101100
}
{ HXS C 201101100200
}
}
*****************************************************************************
* End of TETRIS.S
*****************************************************************************
END_SRC
--
+-----------------------------------+---------------------------------------+
| `What a depressingly | Detlef Mueller |
| stupid machine` | detlef@mwhh.hanse.de |
| Marvin |...!uunet!mcsun!unido!mcshh!mwhh!detlef|
+-----------------------------------+---------------------------------------+